perm filename FAI2F4.F4[P11,LCS]1 blob sn#583813 filedate 1981-05-01 generic text, type T, neo UTF8
00100		DIMENSION I(80),JJ(10)
00200		EQUIVALENCE (I,JJ)
00300	1	FORMAT(' TYPE INPUT NAME  '$)
00400	2	FORMAT(' TYPE OUTPUT NAME  '$)
00500		K=80
00600	3	FORMAT(A10)
00700	4	FORMAT(A5)
00800		DOUBLE PRECISION NAM1
00900		TYPE 1
01000		ACCEPT 3,NAM1
01100		CALL DEFINE(1,NNN,0,NAM1)
01200		TYPE 2
01300		ACCEPT 4,NAM2
01400		CALL OFILE(21,NAM2)
01500	5	FORMAT(80A1)
01600	6	READ(1,5)I
01700		TYPE 5,JJ
01800		CALL SHORT(I,K)
01900		TYPE 7
02000	7	FORMAT(' START HERE?  '$)
02100		ACCEPT 4,L
02150		IF(L.EQ.'Y')GO TO 10
02200		CALL WRITER(I,K)
02300		GO TO 6
02400	8	READ(1,5,END=9)I
02500		CALL SHORT(I,K)
02600	10	CALL CNVRT(I,K)
02700		IF(K.GT.0)CALL WRITER(I,K)
02800		GO TO 8
02900	9	END
03000	
03100		SUBROUTINE SHORT(I,K)
03200		DIMENSION I(80)
03300		DO 3 K=80,1,-1
03400	3	IF(I(K).NE.' ')RETURN
03500		K=1
03600		END
03700	
03800		SUBROUTINE CNVRT(I,K)
03900		DIMENSION I(80)
04000	4	I(1)='	'
04100		DO 10 L=2,K
04200		IF(I(L).EQ.';')GO TO 11
04300	10	CONTINUE
04400		K=-1
04450		RETURN
04500	11	N=1
04600		DO 12 M=L+1,K
04700		N=N+1
04800	12	I(N)=I(M)
04900		K=N
05000		END
05100	
05200		SUBROUTINE WRITER(I,K)
05300		DIMENSION I(1)
05400	1	FORMAT(80A1)
05500		WRITE(21,1)(I(J),J=1,K)
05600		END